home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp2.arc / XLIO.C < prev    next >
Encoding:
C/C++ Source or Header  |  1985-01-01  |  3.0 KB  |  150 lines
  1. /* xlio - xlisp i/o routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* external variables */
  6. extern int xlplevel;
  7. extern int xlfsize;
  8. extern NODE *xlstack;
  9. extern NODE *s_stdin;
  10. extern int xldebug;
  11. extern int prompt;
  12.  
  13. /* xlgetc - get a character from a file or stream */
  14. int xlgetc(fptr)
  15.   NODE *fptr;
  16. {
  17.     NODE *lptr,*cptr;
  18.     FILE *fp;
  19.     int ch;
  20.  
  21.     /* check for input from nil */
  22.     if (fptr == NULL)
  23.     ch = EOF;
  24.  
  25.     /* otherwise, check for input from a stream */
  26.     else if (consp(fptr)) {
  27.     if ((lptr = car(fptr)) == NULL)
  28.         ch = EOF;
  29.     else {
  30.         if (!consp(lptr) ||
  31.         (cptr = car(lptr)) == NULL || !fixp(cptr))
  32.         xlfail("bad stream");
  33.         if (rplaca(fptr,cdr(lptr)) == NULL)
  34.         rplacd(fptr,NULL);
  35.         ch = cptr->n_int;
  36.     }
  37.     }
  38.  
  39.     /* otherwise, check for a buffered file character */
  40.     else if (ch = fptr->n_savech)
  41.     fptr->n_savech = 0;
  42.  
  43.     /* otherwise, get a new character */
  44.     else {
  45.  
  46.     /* get the file pointer */
  47.     fp = fptr->n_fp;
  48.  
  49.     /* prompt if necessary */
  50.     if (prompt && fp == stdin) {
  51.  
  52.         /* print the debug level */
  53.         if (xldebug)
  54.         printf("%d:",xldebug);
  55.  
  56.         /* print the nesting level */
  57.         if (xlplevel > 0)
  58.         printf("%d",xlplevel);
  59.  
  60.         /* print the prompt */
  61.         printf("> ");
  62.         prompt = FALSE;
  63.     }
  64.  
  65.     /* get the character */
  66.     if (((ch = getc(fp)) == '\n' || ch == EOF) && fp == stdin)
  67.         prompt = TRUE;
  68.  
  69.     /* check for input abort */
  70.     if (fp == stdin && ch == '\007') {
  71.         putchar('\n');
  72.         xlabort("input aborted");
  73.     }
  74.     }
  75.  
  76.     /* return the character */
  77.     return (ch);
  78. }
  79.  
  80. /* xlpeek - peek at a character from a file or stream */
  81. int xlpeek(fptr)
  82.   NODE *fptr;
  83. {
  84.     NODE *lptr,*cptr;
  85.     int ch;
  86.  
  87.     /* check for input from nil */
  88.     if (fptr == NULL)
  89.     ch = EOF;
  90.  
  91.     /* otherwise, check for input from a stream */
  92.     else if (consp(fptr)) {
  93.     if ((lptr = car(fptr)) == NULL)
  94.         ch = EOF;
  95.     else {
  96.         if (!consp(lptr) ||
  97.         (cptr = car(lptr)) == NULL || !fixp(cptr))
  98.         xlfail("bad stream");
  99.         ch = cptr->n_int;
  100.     }
  101.     }
  102.  
  103.     /* otherwise, get the next file character and save it */
  104.     else
  105.     ch = fptr->n_savech = xlgetc(fptr);
  106.  
  107.     /* return the character */
  108.     return (ch);
  109. }
  110.  
  111. /* xlputc - put a character to a file or stream */
  112. xlputc(fptr,ch)
  113.   NODE *fptr; int ch;
  114. {
  115.     NODE *oldstk,lptr;
  116.  
  117.     /* count the character */
  118.     xlfsize++;
  119.  
  120.     /* check for output to nil */
  121.     if (fptr == NULL)
  122.     ;
  123.  
  124.     /* otherwise, check for output to a stream */
  125.     else if (consp(fptr)) {
  126.     oldstk = xlsave(&lptr,NULL);
  127.     lptr.n_ptr = newnode(LIST);
  128.     rplaca(lptr.n_ptr,newnode(INT));
  129.     car(lptr.n_ptr)->n_int = ch;
  130.     if (cdr(fptr))
  131.         rplacd(cdr(fptr),lptr.n_ptr);
  132.     else
  133.         rplaca(fptr,lptr.n_ptr);
  134.     rplacd(fptr,lptr.n_ptr);
  135.     xlstack = oldstk;
  136.     }
  137.  
  138.     /* otherwise, output the character to a file */
  139.     else
  140.     putc(ch,fptr->n_fp);
  141. }
  142.  
  143. /* xlflush - flush the input buffer */
  144. int xlflush()
  145. {
  146.     if (!prompt)
  147.     while (xlgetc(s_stdin->n_symvalue) != '\n')
  148.         ;
  149. }
  150.